home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch14 / Weighted.cls < prev    next >
Text File  |  1999-06-22  |  7KB  |  235 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "WeightedGrid3d"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15.  
  16. Private TheGrid As Grid3d   ' The display grid.
  17.  
  18. Private NumPts As Integer   ' # actual data values.
  19. Private Data() As Point3D   ' Actual data values.
  20.  
  21. Public ShowData As Boolean  ' Draw the actual data?
  22. ' Return the index of the nearest point in the
  23. ' indicated direction.
  24. Private Function NearestPoint(ByVal X As Single, ByVal Z As Single, ByVal on_left As Boolean, ByVal on_top As Boolean) As Integer
  25. Dim i As Integer
  26. Dim best_i As Integer
  27. Dim best_dist2 As Single
  28. Dim diffx As Single
  29. Dim diffz As Single
  30. Dim dist2 As Single
  31.  
  32.     ' Start with the first data point.
  33.     best_i = 0
  34.     best_dist2 = 1E+30
  35.  
  36.     ' See which points are closer.
  37.     For i = 1 To NumPts
  38.         ' See if the point satisfies on_left/on_top.
  39.         If CBool(X < Data(i).coord(1)) = on_left And _
  40.            CBool(Z > Data(i).coord(3)) = on_top Then
  41.  
  42.             ' See if this point is closer than the
  43.             ' best one so far.
  44.             diffx = X - Data(i).coord(1)
  45.             diffz = Z - Data(i).coord(3)
  46.             dist2 = diffx * diffx + diffz * diffz
  47.             If dist2 < best_dist2 Then
  48.                 best_i = i
  49.                 best_dist2 = dist2
  50.             End If
  51.         End If
  52.     Next i
  53.  
  54.     NearestPoint = best_i
  55. End Function
  56. ' Return a weighted average for this point's value.
  57. Private Function WeightedAverage(ByVal X As Single, ByVal Z As Single, best_i() As Integer, ByVal num As Integer) As Single
  58. Dim i As Integer
  59. Dim j As Integer
  60. Dim diffx As Single
  61. Dim diffz As Single
  62. Dim dist2(1 To 4) As Single
  63. Dim wgt As Single
  64. Dim tot As Single
  65. Dim Y As Single
  66.  
  67.     ' Compute the distance squared to each point.
  68.     For i = 1 To num
  69.         diffx = X - Data(best_i(i)).coord(1)
  70.         diffz = Z - Data(best_i(i)).coord(3)
  71.         dist2(i) = diffx * diffx + diffz * diffz
  72.         If dist2(i) = 0 Then
  73.             Y = Data(best_i(i)).coord(2)
  74.             Exit Function
  75.         End If
  76.     Next i
  77.  
  78.     ' Compute the contribution due to each point.
  79.     Y = 0
  80.     For i = 1 To num
  81.         ' Compute the weight for point i.
  82.         wgt = 1
  83.         For j = 1 To num
  84.             If j <> i Then
  85.                 wgt = wgt * dist2(j)
  86.             End If
  87.         Next j
  88.         Y = Y + wgt * Data(best_i(i)).coord(2)
  89.         tot = tot + wgt
  90.     Next i
  91.  
  92.     WeightedAverage = Y / tot
  93. End Function
  94. ' Create the grid values for display.
  95. '
  96. ' Dx and Dz tell how far apart to make the grid
  97. ' lines.
  98. Public Sub InitializeGrid(ByVal Dx As Single, ByVal Dz As Single)
  99. Dim Xmin As Single
  100. Dim Xmax As Single
  101. Dim Zmin As Single
  102. Dim Zmax As Single
  103. Dim NumX As Integer
  104. Dim NumZ As Integer
  105. Dim wid As Single
  106. Dim hgt As Single
  107. Dim i As Integer
  108. Dim j As Integer
  109. Dim X As Single
  110. Dim Y As Single
  111. Dim Z As Single
  112. Dim best_i(1 To 4) As Integer
  113. Dim num_close As Integer
  114.  
  115.     ' Find the X and Z data bounds.
  116.     Xmin = Data(1).coord(1)
  117.     Xmax = Xmin
  118.     Zmin = Data(1).coord(3)
  119.     Zmax = Zmin
  120.     For i = 2 To NumPts
  121.         If Xmin > Data(i).coord(1) Then Xmin = Data(i).coord(1)
  122.         If Xmax < Data(i).coord(1) Then Xmax = Data(i).coord(1)
  123.         If Zmin > Data(i).coord(3) Then Zmin = Data(i).coord(3)
  124.         If Zmax < Data(i).coord(3) Then Zmax = Data(i).coord(3)
  125.     Next i
  126.  
  127.     ' Set the data boundaries.
  128.     wid = Xmax - Xmin
  129.     hgt = Zmax - Zmin
  130.     NumX = wid / Dx + 1
  131.     NumZ = hgt / Dz + 1
  132.     X = (wid - NumX * Dx) / 2
  133.     Z = (hgt - NumZ * Dz) / 2
  134.     Xmin = Xmin - X
  135.     Xmax = Xmax + X
  136.     Zmin = Zmin - Z
  137.     Zmax = Zmax + Z
  138.     
  139.     ' Create the new grid object.
  140.     Set TheGrid = New Grid3d
  141.     TheGrid.SetBounds Xmin, Dx, NumX, Zmin, Dz, NumZ
  142.  
  143.     ' Fill in data values.
  144.     X = Xmin
  145.     For i = 1 To NumX
  146.         Z = Zmin
  147.         For j = 1 To NumZ
  148.             ' Find close points to the upper left,
  149.             ' upper right, lower left, and lower
  150.             ' right. Average them.
  151.             num_close = 1
  152.             best_i(num_close) = NearestPoint( _
  153.                 X, Z, True, True)
  154.             If best_i(num_close) > 0 Then num_close = num_close + 1
  155.  
  156.             best_i(num_close) = NearestPoint( _
  157.                 X, Z, True, False)
  158.             If best_i(num_close) > 0 Then num_close = num_close + 1
  159.  
  160.             best_i(num_close) = NearestPoint( _
  161.                 X, Z, False, True)
  162.             If best_i(num_close) > 0 Then num_close = num_close + 1
  163.  
  164.             best_i(num_close) = NearestPoint( _
  165.                 X, Z, False, False)
  166.             If best_i(num_close) > 0 Then num_close = num_close + 1
  167.  
  168.             Y = WeightedAverage(X, Z, best_i, num_close - 1)
  169.  
  170.             ' Add the value to the grid.
  171.             TheGrid.SetValue X, Y, Z
  172.             Z = Z + Dz
  173.         Next j
  174.         X = X + Dx
  175.     Next i
  176. End Sub
  177.  
  178. ' Set a data value.
  179. Public Sub SetValue(ByVal X As Single, ByVal Y As Single, ByVal Z As Single)
  180.     NumPts = NumPts + 1
  181.     ReDim Preserve Data(1 To NumPts)
  182.     With Data(NumPts)
  183.         .coord(1) = X
  184.         .coord(2) = Y
  185.         .coord(3) = Z
  186.         .coord(4) = 1#
  187.     End With
  188. End Sub
  189. ' Apply a transformation matrix which may not
  190. ' contain 0, 0, 0, 1 in the last column to the
  191. ' object.
  192. Public Sub ApplyFull(M() As Single)
  193. Dim i As Integer
  194.  
  195.     ' Apply the matrix to the grid if it exists.
  196.     If Not TheGrid Is Nothing Then TheGrid.ApplyFull M
  197.  
  198.     ' Apply the matrix to the sparse data.
  199.     For i = 1 To NumPts
  200.         m3ApplyFull Data(i).coord, M, Data(i).trans
  201.     Next i
  202. End Sub
  203.  
  204. ' Apply a transformation matrix to the object.
  205. Public Sub Apply(M() As Single)
  206. Dim i As Integer
  207.     
  208.     ' Apply the matrix to the grid if it exists.
  209.     If Not TheGrid Is Nothing Then TheGrid.Apply M
  210.  
  211.     ' Apply the matrix to the sparse data.
  212.     For i = 1 To NumPts
  213.         m3Apply Data(i).coord, M, Data(i).trans
  214.     Next i
  215. End Sub
  216.  
  217.  
  218. ' Draw the transformed points on a PictureBox.
  219. Public Sub Draw(ByVal pic As PictureBox, Optional R As Variant)
  220. Dim i As Integer
  221.     
  222.     ' Draw the grid if it exists.
  223.     If Not TheGrid Is Nothing Then TheGrid.Draw pic
  224.  
  225.     ' Draw the original data points if desired.
  226.     If ShowData Then
  227.         pic.FillStyle = vbFSSolid
  228.         pic.FillColor = vbRed
  229.         On Error Resume Next
  230.         For i = 1 To NumPts
  231.             pic.Circle (Data(i).trans(1), Data(i).trans(2)), 3, vbRed
  232.         Next i
  233.     End If
  234. End Sub
  235.